home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Library / Manuels & Misc / Assembly / AOA.ZIP / CH02 / PASFUNC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-12-15  |  3.4 KB  |  121 lines
  1. program GenericFunc(input,output);
  2. type
  3.     gftype = array [0..15] of integer;
  4.  
  5. var
  6.    a, b, c, d:integer;
  7.    fresult:integer;
  8.    func: gftype;
  9.  
  10.  
  11. (* Standard Pascal does not provide the ability to shift integer data   *)
  12. (* to the left or right.  Therefore, we will simulate a 16-bit value    *)
  13. (* using an array of 16 integers.  We can simulate shifts by moving     *)
  14. (* data around in the array.                                            *)
  15. (*                                                                      *)
  16. (* Note that Turbo Pascal *does* provide shl and shr operators.  How-   *)
  17. (* ever, this code is written to work with standard Pascal, not just    *)
  18. (* Turbo Pascal.                                                        *)
  19.  
  20. procedure ShiftLeft(shiftin:integer);
  21. var i:integer;
  22. begin
  23.  
  24.      for i := 15 downto 1 do func[i] := func[i-1];
  25.      func[0] := shiftin;
  26.  
  27. end;
  28.  
  29. procedure ShiftNibble(d,c,b,a:integer);
  30. begin
  31.  
  32.      ShiftLeft(d);
  33.      ShiftLeft(c);
  34.      ShiftLeft(b);
  35.      ShiftLeft(a);
  36. end;
  37.  
  38.  
  39. procedure ShiftRight;
  40. var i:integer;
  41. begin
  42.  
  43.      for i := 0 to 14 do func[i] := func[i+1];
  44.      func[15] := 0;
  45.  
  46. end;
  47.  
  48. procedure toupper(var ch:char);
  49. begin
  50.  
  51.      if (ch in ['a'..'z']) then ch := chr(ord(ch) - 32);
  52.  
  53. end;
  54.  
  55. function ReadFunc:integer;
  56. var ch:char;
  57.     i, val:integer;
  58. begin
  59.  
  60.      write('Enter function number (hexadecimal): ');
  61.      for i := 0 to 15 do func[i] := 0;
  62.      repeat
  63.  
  64.            read(ch);
  65.            if not eoln then begin
  66.  
  67.                       toupper(ch);
  68.                       case ch of
  69.                            '0': ShiftNibble(0,0,0,0);
  70.                            '1': ShiftNibble(0,0,0,1);
  71.                            '2': ShiftNibble(0,0,1,0);
  72.                            '3': ShiftNibble(0,0,1,1);
  73.                            '4': ShiftNibble(0,1,0,0);
  74.                            '5': ShiftNibble(0,1,0,1);
  75.                            '6': ShiftNibble(0,1,1,0);
  76.                            '7': ShiftNibble(0,1,1,1);
  77.                            '8': ShiftNibble(1,0,0,0);
  78.                            '9': ShiftNibble(1,0,0,1);
  79.                            'A': ShiftNibble(1,0,1,0);
  80.                            'B': ShiftNibble(1,0,1,1);
  81.                            'C': ShiftNibble(1,1,0,0);
  82.                            'D': ShiftNibble(1,1,0,1);
  83.                            'E': ShiftNibble(1,1,1,0);
  84.                            'F': ShiftNibble(1,1,1,1);
  85.                            else write(chr(7),chr(8));
  86.                       end;
  87.            end;
  88.      until eoln;
  89.      val := 0;
  90.      for i := 0 to 15 do val := val + func[i];
  91.      ReadFunc := val;
  92. end;
  93.  
  94.  
  95. (* Generic - Computes the generic logical function specified by *)
  96. (*           the function number "func" on the four input vars  *)
  97. (*           a, b, c, and d.  It does this by returning bit     *)
  98. (*           d*8 + c*4 + b*2 + a from func.  This version re-   *)
  99. (*           lies on Turbo Pascal's shift right operator.       *)
  100.  
  101. function Generic(var func:gftype; a,b,c,d:integer):integer;
  102. begin
  103.           Generic := func[a + b*2 + c*4 + d*8];
  104. end;
  105.  
  106.  
  107. begin (* main *)
  108.  
  109.       repeat
  110.  
  111.             fresult := ReadFunc;
  112.             if (fresult <> 0) then begin
  113.  
  114.                write('Enter values for D, C, B, & A (0/1):');
  115.                readln(d, c, b, a);
  116.                writeln('The result is ',Generic(func,a,b,c,d));
  117.  
  118.             end;
  119.       until fresult = 0;
  120.  
  121. end.